home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
BBS in a Box 15
/
BBS in a box XV-1.iso
/
Files
/
Tele
/
Pete Johnson
/
AreaTrix 1.0.4<source>.sit
/
AreaTrix.p
< prev
next >
Encoding:
Amiga
Atari
Commodore
DOS
FM Towns/JPY
Macintosh
Macintosh JP
NeXTSTEP
RISC OS/Acorn
UTF-8
Wrap
Text File
|
1992-11-08
|
51.6 KB
|
1,415 lines
|
[
TEXT/PJMM
]
program AreaTrix;
{ Written by Pete Johnson }
{ Version 1.04 of 6/10/90 }
{ }
{ 11/18/89 WaitNextEvent added for MF compatibility }
{ 2/8/90 fixed date anomaly for Tabby log }
{ 2/28/90 fixed date error which last bug fix introduced }
{ 3/1/90 changed To: name from 'Sysop' to actual name }
{ 3/4/90 modified for Mansion compatibility }
{ 3/17/90 v. 2.1 added point compatibility and file forwarding to points }
{ 3/18/90 v. 2.3 now sorts point and areas files by area, added configurable }
{ file forward name, fixed many bugs. }
{ 3/20/90 v. 2.4 checks password for file forward (and changed syntax of forward request }
{ to Password > NodeID) }
{ 3/22/90 v. 2.41 writes message confirming files have been forwarded }
{ 3/25/90 v. 2.42 better messages re: file forwarding }
{ 3/26/90 v. 0.90 renamed to AreaTrix, delete files which have been forwarded }
{ 3/27/90 v. 0.91 added help file response to ? in subject line, shortened }
{ 'Response' to 'Reply' in answer message subject }
{ 3/28/90 v. 0.92 fixed error in format of PointGroups file }
{ 3/30/90 v. 1.0 changed version number for release }
{ 4/16/90 v. 1.01 fixed bug which froze program if :Tabby:AreaTrix Workfile didn't exist }
{ 4/22/90 v. 1.02 added option to not delete forwarded files }
{ 4/29/90 v. 1.03 delete feed only if '-' is first character of line }
{ 5/10/90 v. 1.04 if line in areas.bbs or pointgroups file doesn't have at least one tab, }
{ it is ignored. Previously this would cause file corruption. }
{ 6/10/90 priv fixed areas.bbs sort so that Unknown is always last an pass-thrus are }
{ just prior to Unknown, in alphabetical order. }
{ }
uses
Globals, HelloTabby, NewFileUtils, ConfigDialog, PurgeFiles, PreScan, MiscUtils;
const
debug = false; {enable when testing weird new code}
var
AreafixRef, GenericRef, TLogRef, MessageCount: integer;
Request, SendList, SendAreas, ListForwards: boolean;
GenericPath, OptionStr, PointNetString: STR255;
TempString, TheVers, FromName: STR255;
ForwardName, CapsFwdName, FREQName, CapsFREQName, AgentName, CapsAgentName: STR255;
GenericEOF: longint;
MsgToSysopStrHdl: StringHandle;
MsgToSysop, ListOK, GoodPassword, TabbyLog, FixPending, FromPoint, SendHelp, ListFREQs: boolean;
DialogPointer: DialogPtr;
{ ------------------------------------------------------ }
procedure ParseReq;
type
Area = record
AreaNum: string[3];
AreaName: string[30];
Receivers: array[1..8] of string[12];
Key: string[8];
PointFeed: boolean;
end;
AreaPtr = ^Area;
AreaHndl = ^AreaPtr;
AllAreaHandle = array[1..255] of AreaHndl;
MsgTextLine = STR255;
MsgTextPtr = ^MsgTextLine;
MsgTextHndl = ^MsgTextPtr;
OneString = string;
OneStringPtr = ^OneString;
OneStringHndl = ^OneStringPtr;
var
FlagLine, Ignore, ToName, CapsToName, NodeID, Subject, TextLine, LocalNodeID, SendFileName, OneLine: STR255;
MessageLine, MessageKey, UserKey, TempLogString: STR255;
Deletes, Adds: array[1..255] of OneStringHndl;
FlagPos, logicalEOF, AreaFixEOF, CharsToSend: longint;
Index, AreaIndex, PointIndex, Counter, Colon, TConfigRef, DeleteCount, AddCount, FilesToDo: integer;
SendFilesRef, FileCheckRef, GenExpRef, ForwardLogRef, AFWLogRef, ScriptRef: integer;
AreaArray, PointFeedArray: AllAreaHandle;
ThisAreaItem, ThisPtItem: Area;
MsgTextArray: array[1..400] of MsgTextHndl;
Empty: boolean;
{ ------------------------------------------------------ }
function BlankStrip (Line: STR255): string;
begin
while (Line[1] in [SPACE, TAB]) & (length(Line) > 1) do
Line := copy(Line, 2, length(Line) - 1);
while (Line[length(Line)] in [SPACE, TAB]) & (length(Line) > 1) do
Line := copy(Line, 1, length(Line) - 1);
BlankStrip := Line
end;
{ ------------------------------------------------------ }
procedure PurgeArea (AnArea: AllAreaHandle; AreaIndex: integer; AreaName, NodeID: STR255);
var
AreaCount, FeedCount: integer;
begin
for AreaCount := 1 to AreaIndex do
if AnArea[AreaCount]^^.AreaName = AreaName then
for FeedCount := 1 to 8 do
if AnArea[AreaCount]^^.Receivers[FeedCount] = NodeID then
AnArea[AreaCount]^^.Receivers[FeedCount] := ''
end;
{ ------------------------------------------------------ }
procedure WriteClosing (FRef: integer);
begin
MessageLine := ' ';
Err := MyWriteLine(FRef, MessageLine);
MessageLine := concat('--- AreaTrix ', TheVers);
Err := MyWriteLine(FRef, MessageLine);
MessageLine := NULL;
Err := MyWriteLine(FRef, MessageLine)
end;
{ ------------------------------------------------------ }
procedure WriteHeading (FRef: integer; Pseudonym: str255);
begin
MessageLine := ' M ';
Err := MyWriteLine(FRef, MessageLine); { flags }
MessageLine := '000';
Err := MyWriteLine(FRef, MessageLine); { category }
TimeStamp;
Err := MyWriteLine(FRef, DateString); { date }
Err := MyWriteLine(FRef, TimeString); { time }
Err := MyWriteLine(FRef, NodeID); { address }
MessageLine := concat(Pseudonym, ' on ', LocalNodeID);
Err := MyWriteLine(FRef, MessageLine); { from }
Err := MyWriteLine(FRef, FromName); { to }
MessageLine := concat('Reply to ', Pseudonym, ' Request');
Err := MyWriteLine(FRef, MessageLine) { subject }
end;
{ ------------------------------------------------------ }
procedure InterpretRequest;
procedure CheckPassword;
var
PWRefNum, UserKeyRefNum, SpacePos: integer;
PWLine, TempPass1, TempPass2: STR255;
begin
if pos(SPACE, Subject) > 1 then
TempPass2 := copy(Subject, 1, pos(SPACE, Subject) - 1)
else
TempPass2 := Subject;
Err := FSOpen(':Tabby:AreaPass', vRefNum, PWRefNum);
if (Err <> NoErr) then
Err := FSOpen(':Tabby:Password', vRefNum, PWRefNum);
while not AtEOF(PWRefNum) & not GoodPassword do
begin
Err := ReadALine(PWRefNum, PWLine);
if (pos(NodeID, PWLine) > 0) then
begin
TempPass1 := copy(PWLine, pos(TAB, PWLine) + 1, 255);
if TempPass1 = TempPass2 then
GoodPassword := true
end { if (pos(NodeID, PWLine) > 0) }
end; { while not AtEOF(PWRefNum) & not GoodPassword }
Err := FSClose(PWRefNum);
UserKey := '';
Err := FSOpen(':Tabby:AreaUserKeys', vRefNum, UserKeyRefNum);
if Err = NoErr then
while (not AtEOF(UserKeyRefNum)) & (Err = NoErr) do
begin
Err := ReadALine(UserKeyRefNum, TempString);
if (pos(NodeId, TempString) > 0) & (Err = NoErr) then
begin
UserKey := BlankStrip(TempString);
UserKey := copy(UserKey, pos(TAB, UserKey) + 1, 255);
UserKey := BlankStrip(UserKey)
end
end;
Err := FSClose(UserKeyRefNum)
end;
begin
GoodPassword := false;
SendHelp := false;
SendList := false;
SendAreas := false;
if (BlankStrip(Subject) = '?') | (BlankStrip(MsgTextArray[1]^^) = '?') then
begin
SendHelp := true;
Request := true
end;
CheckPassword;
if (GoodPassword | ListOK) then
begin
Request := true;
UprString(Subject, false);
if (pos('-L', Subject) > 0) | (pos('*', MsgTextArray[1]^^) > 0) then
SendList := true;
if (pos('-Q', Subject) > 0) then
SendAreas := true
end { if GoodPassword }
else
begin
MakeTextFile(concat(GenericPath, 'Generic Export'));
Err := FSOpen(concat(GenericPath, 'Generic Export'), vRefNum, GenericRef);
Err := SetFPos(GenericRef, fsFromLEOF, 0);
WriteHeading(GenericRef, 'AreaFix');
MessageLine := 'You do not have a proper password to use AreaFix, or else you entered the';
Err := MyWriteLine(GenericRef, MessageLine);
MessageLine := 'password incorrectly. Please ask the System Operator for a password.';
Err := MyWriteLine(GenericRef, MessageLine);
MessageLine := ' ';
Err := MyWriteLine(GenericRef, MessageLine);
WriteClosing(GenericRef);
Err := FSClose(GenericRef);
end { good Password or ListOK }
end;
{ ------------------------------------------------------ }
function ReadAreaLine (LeftOver: STR255): Area;
var
PlaceMark, StringIndex, NodeIndex, TempCount: integer;
TempArea: Area;
PointSwitch: STR255;
begin
TempArea.AreaName := '';
PlaceMark := pos(TAB, LeftOver);
if (PlaceMark > 1) then
begin
TempArea.AreaNum := copy(LeftOver, 1, PlaceMark - 1);
PointSwitch := concat('0/', TempArea.AreaNum); { Feeds to point are of form 0/AreaNum }
LeftOver := copy(LeftOver, PlaceMark + 1, length(LeftOver) - PlaceMark);
UprString(LeftOver, false);
PlaceMark := pos(TAB, LeftOver);
if (PlaceMark > 1) then
begin
TempArea.AreaName := copy(LeftOver, 1, PlaceMark - 1);
LeftOver := copy(LeftOver, PlaceMark + 1, length(LeftOver) - PlaceMark);
StringIndex := 1;
NodeIndex := 1;
for TempCount := 1 to 8 do
TempArea.Receivers[TempCount] := '';
while StringIndex <= length(LeftOver) do
begin
while (LeftOver[StringIndex] <> SPACE) & (StringIndex <= length(LeftOver)) do
begin
TempArea.Receivers[NodeIndex] := concat(TempArea.Receivers[NodeIndex], LeftOver[StringIndex]);
StringIndex := succ(StringIndex);
end; { while LeftOver[StringIndex] <> chr(32)) & (StringIndex <= length(LeftOver) }
if pos(PointSwitch, TempArea.Receivers[NodeIndex]) = 1 then
TempArea.PointFeed := true
else
TempArea.PointFeed := false;
StringIndex := succ(StringIndex);
NodeIndex := succ(NodeIndex);
TempArea.Key := '';
end { while StringIndex <= length(LeftOver) }
end { if (PlaceMark > 1) }
end; { if (PlaceMark > 1) }
ReadAreaLine := TempArea
end;
{ ------------------------------------------------------ }
procedure ReadAreas;
var
AreasRef, Counter: integer;
AreaEOF: longint;
TempLine, AreaName, AreaKey: STR255;
TempArea: Area;
begin
AreaIndex := 0;
Err := FSOpen(':Tabby:areas.bbs', vRefNum, AreasRef);
if Err = NoErr then
while (not AtEOF(AreasRef)) do
begin
Err := ReadALine(AreasRef, TempLine);
if AreaIndex > 0 then { This skips the first line }
begin
TempArea := ReadAreaLine(TempLine);
if TempArea.AreaName <> '' then
begin
AreaArray[AreaIndex] := AreaHndl(NewHandle(sizeOf(Area)));
HLock(Handle(AreaArray[AreaIndex]));
AreaArray[AreaIndex]^^ := TempArea;
AreaIndex := succ(AreaIndex)
end { if TempArea.AreaName <> '' }
end { if AreaIndex > 0 }
else
AreaIndex := succ(AreaIndex)
end; { while (AreaLoc < AreaEOF) }
AreaIndex := pred(AreaIndex);
Err := FSClose(AreasRef);
Err := FSOpen(':Tabby:AreaKeys', vRefNum, AreasRef);
if Err = NoErr then
begin
while not AtEOF(AreasRef) do
begin
Err := ReadALine(AreasRef, TempLine);
if (pos(TAB, TempLine) > 0) & (length(TempLine) > 0) then
begin
TempLine := BlankStrip(TempLine);
AreaName := copy(TempLine, 1, pos(TAB, Templine) - 1);
AreaName := BlankStrip(AreaName);
AreaKey := copy(TempLine, pos(TAB, Templine) + 1, 255);
AreaKey := BlankStrip(AreaKey);
for Counter := 1 to AreaIndex do
if AreaArray[Counter]^^.AreaName = AreaName then
AreaArray[Counter]^^.Key := copy(AreaKey, 1, 8)
end { if (pos(TAB, TempLine) > 0) & (length(TempLine) > 0) }
end; { while not at eof AreaKeys }
Err := FSClose(AreasRef)
end { no error opening AreaKeys file }
end;
{ ------------------------------------------------------ }
procedure ReadPointFeeds;
var
PointsRef: integer;
AreaEOF: longint;
TempLine: STR255;
TempArea: Area;
begin
PointIndex := 1;
Err := FSOpen(':Tabby:PointGroups', vRefNum, PointsRef);
if Err = NoErr then
while (not AtEOF(PointsRef)) do
begin
Err := ReadALine(PointsRef, TempLine);
TempArea := ReadAreaLine(TempLine);
if TempArea.AreaName <> '' then
begin
PointFeedArray[PointIndex] := AreaHndl(NewHandle(sizeOf(Area)));
HLock(Handle(PointFeedArray[PointIndex]));
PointFeedArray[PointIndex]^^ := TempArea;
PointIndex := succ(PointIndex)
end { if TempArea.AreaName <> '' }
end; { while (AreaLoc < AreaEOF) }
PointIndex := pred(PointIndex);
Err := FSClose(PointsRef)
end;
{ ------------------------------------------------------ }
function Clean (Line: STR255): string;
begin
while (Line[1] in [SPACE, TAB, '+', '-']) & (length(Line) > 1) do
Line := copy(Line, 2, length(Line) - 1);
while (Line[length(Line)] in [SPACE, TAB]) & (length(Line) > 1) do
Line := copy(Line, 1, length(Line) - 1);
uprString(Line, false);
Clean := Line
end;
{ ------------------------------------------------------ }
procedure UpdateAreaFile (FileName: STR255; AreaArray: AllAreaHandle; AreaIndex: integer);
var
AreasRef, BakRef, AreaCount, DlvrCount, DupeCount, First, Current, Least: integer;
AreasLine: str255;
CurrentSect, LeastSect: longint;
begin
Err := FSDelete(concat(FileName, '.bak'), vRefNum);
Err := Rename(FileName, vRefNum, concat(FileName, '.bak'));
Err := Create(FileName, vRefNum, 'QED1', 'TEXT');
Err := FSOpen(FileName, vRefNum, AreasRef);
Err := SetFPos(AreasRef, fsFromStart, 0);
if FileName = ':Tabby:areas.bbs' then { Read and write BBS ID line }
begin
Err := FSOpen(concat(FileName, '.bak'), vRefNum, BakRef);
Err := ReadALine(BakRef, AreasLine); { Read BBS ID line }
Err := FSClose(BakRef);
Err := MyWriteLine(AreasRef, AreasLine)
end;
{ organize AreaArray by Areanum using selection sort [Oh! Pascal pg. 528] }
for First := 1 to AreaIndex - 1 do
begin
Least := First; { Guess that this is the least value }
for Current := First + 1 to AreaIndex do
begin
if AreaArray[Current]^^.AreaName = 'UNKNOWN' then {make sure it's sorted to last place}
CurrentSect := 1000
else if AreaArray[Current]^^.AreaNum = '***' then {put pass-thrus after others, before Unknown}
CurrentSect := 300 + ord(AreaArray[Current]^^.AreaName[1]) {alphabetic by first char}
else
StringToNum(AreaArray[Current]^^.AreaNum, CurrentSect);
if AreaArray[Least]^^.AreaName = 'UNKNOWN' then {make sure it's sorted to last place}
LeastSect := 1000
else if AreaArray[Least]^^.AreaNum = '***' then {put pass-thrus after others, before Unknown}
LeastSect := 300 + ord(AreaArray[Least]^^.AreaName[1]) {alphabetic by first char}
else
StringToNum(AreaArray[Least]^^.AreaNum, LeastSect);
if CurrentSect < LeastSect then
Least := Current
end;
ThisAreaItem := AreaArray[Least]^^; { Swap AreaArray[First] and AreaArray[Least] }
AreaArray[Least]^^ := AreaArray[First]^^;
AreaArray[First]^^ := ThisAreaItem
end;
{ next routine kills dupe entries }
for AreaCount := 1 to AreaIndex do
for DlvrCount := 1 to 8 do
for DupeCount := (DlvrCount + 1) to 8 do
if AreaArray[AreaCount]^^.Receivers[DlvrCount] = AreaArray[AreaCount]^^.Receivers[DupeCount] then
AreaArray[AreaCount]^^.Receivers[DupeCount] := '';
{ next routine puts "0/x" entries at end }
for AreaCount := 1 to AreaIndex do
for DlvrCount := 1 to 7 do
if AreaArray[AreaCount]^^.Receivers[DlvrCount] = concat('0/', AreaArray[AreaCount]^^.AreaNum) then
if AreaArray[AreaCount]^^.Receivers[8] = '' then
begin
AreaArray[AreaCount]^^.Receivers[8] := concat('0/', AreaArray[AreaCount]^^.AreaNum);
AreaArray[AreaCount]^^.Receivers[DlvrCount] := ''
end
else
begin
AreaArray[AreaCount]^^.Receivers[DlvrCount] := AreaArray[AreaCount]^^.Receivers[8];
AreaArray[AreaCount]^^.Receivers[8] := concat('0/', AreaArray[AreaCount]^^.AreaNum)
end;
for AreaCount := 1 to AreaIndex do
begin
AreasLine := concat(AreaArray[AreaCount]^^.Areanum, TAB, AreaArray[AreaCount]^^.AreaName, TAB);
for DlvrCount := 1 to 8 do
if (length(AreaArray[AreaCount]^^.Receivers[DlvrCount]) > 0) then
AreasLine := concat(AreasLine, AreaArray[AreaCount]^^.Receivers[DlvrCount], SPACE);
if AreasLine[length(AreasLine)] = SPACE then
AreasLine := copy(AreasLine, 1, length(AreasLine) - 1);
Err := MyWriteLine(AreasRef, AreasLine)
end; { for AreaCount := 1 to AreaIndex }
Err := GetFPos(AreasRef, logicalEOF);
Err := SetEOF(AreasRef, logicalEOF);
Err := FSClose(AreasRef)
end;
{ ------------------------------------------------------ }
procedure AlterAreas;
var
MLineCount, AlterCount, DlvrCount, AreasRef, AreaCount, PtCount, DlvrPtCount, Count2: integer;
AreaEOF, Ptlongint, TestLongint: longint;
AreaString, TextString, StrippedMsgText, PointNo: string;
AreasLine: STR255;
Changed: boolean;
begin
DeleteCount := 0;
AddCount := 0;
if UserKey <> '' then { if sysop entered a user key, it overrides }
MessageKey := UserKey
else
MessageKey := '';
for MLineCount := 1 to Index do
begin
StrippedMsgText := Clean(MsgTextArray[MLineCount]^^);
if (StrippedMsgText <> '*') & (StrippedMsgText <> '?') then
begin
Changed := false;
if (MLineCount = 1) & (pos('KEY:', StrippedMsgText) > 0) & (MessageKey = '') then
begin
{ next line keeps original case of message line for more keyword flexibility. We know }
{ the line contains the word 'Key:' in some case, but we target only the colon for }
{ simplicity. }
MessageKey := copy(MsgTextArray[1]^^, pos(':', MsgTextArray[1]^^) + 1, 255);
MessageKey := BlankStrip(MessageKey);
end
else
begin
for AlterCount := 1 to AreaIndex do
begin
ThisAreaItem := AreaArray[AlterCount]^^;
if (ThisAreaItem.AreaName = StrippedMsgText) then
if (ThisAreaItem.Key = '') | (pos(ThisAreaItem.Key, MessageKey) > 0) then
if (pos('-', MsgTextArray[MLineCount]^^) = 1) then
begin
if FromPoint & ThisAreaItem.PointFeed then
begin
PointNo := copy(NodeID, pos('/', NodeID) + 1, 255); {Get point number}
StringToNum(PointNo, PtLongint);
{ Check & see if it's possible to remove from point feed }
for PtCount := 1 to PointIndex do
begin
ThisPtItem := PointFeedArray[PtCount]^^;
if (ThisPtItem.AreaName = StrippedMsgText) then
for DlvrPtCount := 1 to 8 do
begin
{ Remember that points are stored by numbers only, not complete addresses!!! }
StringToNum(ThisPtItem.Receivers[DlvrPtCount], TestLongint);
if TestLongint = PtLongint then
begin
PointFeedArray[PtCount]^^.Receivers[DlvrPtCount] := '';
DeleteCount := succ(DeleteCount);
Deletes[DeleteCount] := OneStringHndl(NewHandle(sizeOf(OneString)));
Deletes[DeleteCount]^^ := ThisPtItem.AreaName;
PurgeArea(AreaArray, AreaIndex, StrippedMsgText, NodeID); { Get rid of Areas.bbs refs }
Changed := true;
Leave { done: exit DlvrPtCount := 1 to 8 loop }
end
end { for DlvrPtCount := 1 to 8 }
end { for PtCount := 1 to PointIndex }
end; { if FromPoint & ThisAreaItem.PointFeed }
if not Changed then
for DlvrCount := 2 to 8 do { Start at 2 so not to delete feed }
if (pos(NodeID, AreaArray[AlterCount]^^.Receivers[DlvrCount]) > 0) & (length(AreaArray[AlterCount]^^.Receivers[DlvrCount]) > 0) then
begin
AreaArray[AlterCount]^^.Receivers[DlvrCount] := '';
DeleteCount := succ(DeleteCount);
Deletes[DeleteCount] := OneStringHndl(NewHandle(sizeOf(OneString)));
Deletes[DeleteCount]^^ := ThisAreaItem.AreaName;
Changed := true;
Leave
end
end { if (pos('-', MsgTextArray[MLineCount]^^) = 1) }
else
begin { Need to add it }
if FromPoint & ThisAreaItem.PointFeed then
begin
PurgeArea(AreaArray, AreaIndex, StrippedMsgText, NodeID); { Get rid of Areas.bbs refs }
PointNo := copy(NodeID, pos('/', NodeID) + 1, 255); {Get point number}
StringToNum(PointNo, PtLongint);
{ Check & see if it's possible to add to point feed }
for PtCount := 1 to PointIndex do
begin
ThisPtItem := PointFeedArray[PtCount]^^;
if (ThisPtItem.AreaName = StrippedMsgText) then
begin
for DlvrPtCount := 1 to 8 do { Purge list of this NodeID }
begin
StringToNum(ThisPtItem.Receivers[DlvrPtCount], TestLongint);
if TestLongint = PtLongint then
PointFeedArray[PtCount]^^.Receivers[DlvrPtCount] := ''
end;
for DlvrPtCount := 1 to 8 do { Now add it to the first empty spot }
if (length(PointFeedArray[PtCount]^^.Receivers[DlvrPtCount]) = 0) then
begin
PointFeedArray[PtCount]^^.Receivers[DlvrPtCount] := PointNo;
AddCount := succ(AddCount);
Adds[AddCount] := OneStringHndl(NewHandle(sizeOf(OneString)));
Adds[AddCount]^^ := ThisPtItem.AreaName;
Changed := true;
Leave { added NodeId, so exit loop }
end; { for DlvrPtCount := 1 to 8 }
end; { if (ThisPtItem.AreaName = StrippedMsgText) }
if Changed then
leave;
end; { for PtCount := 1 to PointIndex }
if not Changed then { no room in existing PointFeedArray, so add new one }
begin
TempString := '';
for Count2 := 1 to AreaIndex do { Get the area number for this section }
if AreaArray[Count2]^^.AreaName = StrippedMsgText then
begin
TempString := AreaArray[Count2]^^.AreaNum;
Leave
end;
if TempString <> '' then
begin
PointIndex := succ(PointIndex);
PointFeedArray[PointIndex] := AreaHndl(NewHandle(sizeOf(Area)));
HLock(Handle(PointFeedArray[PointIndex]));
PointFeedArray[PointIndex]^^.AreaNum := TempString;
PointFeedArray[PointIndex]^^.AreaName := StrippedMsgText;
for Count2 := 1 to 8 do
PointFeedArray[PointIndex]^^.Receivers[Count2] := '';
PointFeedArray[PointIndex]^^.Receivers[1] := PointNo;
PointFeedArray[PointIndex]^^.PointFeed := true;
AddCount := succ(AddCount);
Adds[AddCount] := OneStringHndl(NewHandle(sizeOf(OneString)));
Adds[AddCount]^^ := ThisPtItem.AreaName;
Changed := true
end; { if TempString <> '' }
end; { if not Changed }
end; { if FromPoint & ThisAreaItem.PointFeed }
if not Changed then
begin
for DlvrCount := 1 to 8 do { Purge list of this NodeID }
if (pos(NodeID, ThisAreaItem.Receivers[DlvrCount]) > 0) then
AreaArray[AlterCount]^^.Receivers[DlvrCount] := '';
for DlvrCount := 1 to 8 do { Now add it to the first empty spot }
if (length(ThisAreaItem.Receivers[DlvrCount]) = 0) then
begin
AreaArray[AlterCount]^^.Receivers[DlvrCount] := NodeID;
AddCount := succ(AddCount);
Adds[AddCount] := OneStringHndl(NewHandle(sizeOf(OneString)));
Adds[AddCount]^^ := ThisAreaItem.AreaName;
Leave { added NodeId, so exit loop }
end { for DlvrCount := 1 to 8 }
end { if not Changed }
end { if (pos('-', MsgTextArray[MLineCount]^^) <> 1) [else clause] }
end { for AlterCount := 1 to AreaIndex }
end { if pos('KEY',MsgTextArray) = 0 }
end { if (StrippedMsgText <> '*') & (StrippedMsgText <> '?') }
else
SendAreas := true; { User entered an asterisk to get listing }
end { for MLineCount := 1 to Index }
end;
{ ------------------------------------------------------ }
procedure SendMsg (Pseudonym: str255);
var
AlterCount, DlvrCount, EchoIndex, ListRef, HelpRef: integer;
PointNo: str255;
CharsToRead: longint;
Available: boolean;
begin
MakeTextFile(concat(GenericPath, 'Generic Export'));
if GoodPassword then
begin
MakeTextFile(concat(GenericPath, 'Generic Export'));
Err := FSOpen(concat(GenericPath, 'Generic Export'), vRefNum, GenericRef);
Err := SetFPos(GenericRef, fsFromLEOF, 0);
WriteHeading(GenericRef, 'AreaFix');
MessageLine := 'You are currently sharing the following Echoes with this board (an asterisk';
Err := MyWriteLine(GenericRef, MessageLine);
MessageLine := 'indicates that you are the feed):';
Err := MyWriteLine(GenericRef, MessageLine);
MessageLine := ' ';
Err := MyWriteLine(GenericRef, MessageLine);
for AlterCount := 1 to AreaIndex do
if (AreaArray[AlterCount]^^.Key = '') | (pos(AreaArray[AlterCount]^^.Key, MessageKey) > 0) then
for DlvrCount := 1 to 8 do
if (pos(NodeID, AreaArray[AlterCount]^^.Receivers[DlvrCount])) > 0 then
begin
if DlvrCount = 1 then
MessageLine := '* '
else
MessageLine := ' ';
Err := MyWrite(GenericRef, MessageLine);
MessageLine := AreaArray[AlterCount]^^.AreaName;
Err := MyWriteLine(GenericRef, MessageLine);
leave; { found a node match, so exit the for loop }
end; { if (pos(NodeID, AreaArray[AlterCount]^^.Receivers[DlvrCount])) > 0 }
if pos(PointNetString, NodeID) <> 0 then
begin
PointNo := copy(NodeID, pos('/', NodeID) + 1, 255); {Get point number}
for AlterCount := 1 to PointIndex do
if (PointFeedArray[AlterCount]^^.Key = '') | (pos(PointFeedArray[AlterCount]^^.Key, MessageKey) > 0) then
for DlvrCount := 1 to 8 do
if (pos(PointNo, PointFeedArray[AlterCount]^^.Receivers[DlvrCount])) > 0 then
begin
MessageLine := concat(' ', PointFeedArray[AlterCount]^^.AreaName);
Err := MyWriteLine(GenericRef, MessageLine);
leave { found a node match, so exit the for loop }
end { if (pos(NodeID, PointFeedArray[AlterCount]^^.Receivers[DlvrCount])) > 0 }
end; { if pos(PointNetString, NodeID) <> 0 }
if AddCount > 0 then
begin
MessageLine := ' ';
Err := MyWriteLine(GenericRef, MessageLine);
MessageLine := 'At your request, the following Echo feeds were added:';
Err := MyWriteLine(GenericRef, MessageLine);
MessageLine := ' ';
Err := MyWriteLine(GenericRef, MessageLine);
for AlterCount := 1 to AddCount do
if length(Adds[AlterCount]^^) > 0 then
begin
MessageLine := concat(' ', Adds[AlterCount]^^);
Err := MyWriteLine(GenericRef, MessageLine);
end;
end; { if AddCount > 0 }
if DeleteCount > 0 then
begin
MessageLine := ' ';
Err := MyWriteLine(GenericRef, MessageLine);
MessageLine := 'At your request, the following Echo feeds were discontinued:';
Err := MyWriteLine(GenericRef, MessageLine);
MessageLine := ' ';
Err := MyWriteLine(GenericRef, MessageLine);
for AlterCount := 1 to DeleteCount do
if length(Deletes[AlterCount]^^) > 0 then
begin
MessageLine := concat(' ', Deletes[AlterCount]^^);
Err := MyWriteLine(GenericRef, MessageLine);
end;
end; { if DeleteCount > 0 }
WriteClosing(GenericRef);
Err := FSClose(GenericRef);
if ((DeleteCount > 0) | (AddCount > 0)) & MsgToSysop then
begin
MakeTextFile(concat(GenericPath, 'Generic Import'));
Err := FSOpen(concat(GenericPath, 'Generic Import'), vRefNum, GenericRef);
Err := SetFPos(GenericRef, fsFromLEOF, 0);
MessageLine := ' M ';
Err := MyWriteLine(GenericRef, MessageLine);
MessageLine := '000';
Err := MyWriteLine(GenericRef, MessageLine);
TimeStamp;
Err := MyWriteLine(GenericRef, DateString);
Err := MyWriteLine(GenericRef, TimeString);
Err := MyWriteLine(GenericRef, LocalNodeID);
MessageLine := concat('AreaFix on ', LocalNodeID);
Err := MyWriteLine(GenericRef, MessageLine);
MessageLine := 'Sysop';
Err := MyWriteLine(GenericRef, MessageLine);
MessageLine := 'Notice of AreaFix Request';
Err := MyWriteLine(GenericRef, MessageLine);
MessageLine := concat('At the request of ', FromName, ' at ', NodeID, ', these changes were');
Err := MyWriteLine(GenericRef, MessageLine);
MessageLine := 'made to Echo distribution:';
Err := MyWriteLine(GenericRef, MessageLine);
MessageLine := ' ';
Err := MyWriteLine(GenericRef, MessageLine);
if AddCount > 0 then
begin
for AlterCount := 1 to AddCount do
if length(Adds[AlterCount]^^) > 0 then
begin
MessageLine := concat('Added........ ', Adds[AlterCount]^^);
Err := MyWriteLine(GenericRef, MessageLine);
end;
end; { if AddCount > 0 }
if DeleteCount > 0 then
begin
if AddCount > 0 then
begin
MessageLine := ' ';
Err := MyWriteLine(GenericRef, MessageLine);
end;
for AlterCount := 1 to DeleteCount do
if length(Deletes[AlterCount]^^) > 0 then
begin
MessageLine := concat('Deleted...... ', Deletes[AlterCount]^^);
Err := MyWriteLine(GenericRef, MessageLine);
end;
end; { if DeleteCount > 0 }
WriteClosing(GenericRef);
Err := FSClose(GenericRef);
end; { if ((DeleteCount > 0) | (AddCount > 0)) & MsgToSysop }
end; { if GoodPassword }
if SendList then
begin
Err := FSOpen(concat(':Tabby:AreaFix.List'), vRefNum, ListRef);
if Err <> NoErr then
Err := FSOpen(concat(':Tabby:AreaTrix.List'), vRefNum, ListRef);
if Err = NoErr then
Err := GetEOF(ListRef, logicalEOF);
if Err = NoErr then
begin
MakeTextFile(concat(GenericPath, 'Generic Export'));
Err := FSOpen(concat(GenericPath, 'Generic Export'), vRefNum, GenericRef);
Err := SetFPos(GenericRef, fsFromLEOF, 0);
WriteHeading(GenericRef, 'AreaFix');
MessageLine := 'The following is a list of Echoes carried by this board:';
Err := MyWriteLine(GenericRef, MessageLine);
MessageLine := ' ';
Err := MyWriteLine(GenericRef, MessageLine);
while not AtEOF(ListRef) do
begin
Err := ReadALine(ListRef, MessageLine);
TempString := BlankStrip(MessageLine);
if pos(' ', TempString) > 0 then
begin
TempString := copy(TempString, 1, pos(' ', TempString) - 1); { AreaName is in TempString }
UprString(TempString, false);
for AlterCount := 1 to AreaIndex do
if (AreaArray[AlterCount]^^.AreaName = TempString) then
if (AreaArray[AlterCount]^^.Key = '') | (pos(AreaArray[AlterCount]^^.Key, MessageKey) > 0) then
begin
Err := MyWriteLine(GenericRef, MessageLine);
leave { AlterCount loop }
end
end { if pos(' ', TempString) > 0 }
end; { while not AtEOF(ListRef) }
WriteClosing(GenericRef);
Err := FSClose(GenericRef);
end; { if Err = NoErr for AreaFix.List }
Err := FSClose(ListRef);
end; { if SendList }
if SendAreas then
begin
MakeTextFile(concat(GenericPath, 'Generic Export'));
Err := FSOpen(concat(GenericPath, 'Generic Export'), vRefNum, GenericRef);
Err := SetFPos(GenericRef, fsFromLEOF, 0);
WriteHeading(GenericRef, 'AreaFix');
MessageLine := 'The following is a list of Echoes currently available on this board:';
Err := MyWriteLine(GenericRef, MessageLine);
MessageLine := ' ';
Err := MyWriteLine(GenericRef, MessageLine);
for EchoIndex := 1 to AreaIndex do
begin
with AreaArray[EchoIndex]^^ do
begin
Available := false;
for DlvrCount := 1 to 8 do
if Receivers[DlvrCount] = '' then
Available := true;
if Available & (AreaName <> 'UNKNOWN') then
if (AreaArray[EchoIndex]^^.Key = '') | (pos(AreaArray[EchoIndex]^^.Key, MessageKey) > 0) then
begin
MessageLine := AreaName;
Err := MyWriteLine(GenericRef, MessageLine);
end; { if Available }
end; { with AreaArry[EchoIndex]^^ }
end; { for EchoIndex := 1 to AreaIndex }
WriteClosing(GenericRef);
Err := FSClose(GenericRef)
end; { if SendAreas }
if SendHelp then
begin
MakeTextFile(concat(GenericPath, 'Generic Export'));
Err := FSOpen(concat(GenericPath, 'Generic Export'), vRefNum, GenericRef);
if Err = NoErr then
begin
Err := SetFPos(GenericRef, fsFromLEOF, 0);
WriteHeading(GenericRef, 'AreaFix');
end;
Err := FSOpen(concat(':Tabby:AreaTrix Help'), vRefNum, HelpRef);
if Err = NoErr then
begin
Err := SetFPos(HelpRef, fsFromStart, 0);
while not AtEOF(HelpRef) do
begin
Err := ReadALine(HelpRef, MessageLine);
if Err = NoErr then
Err := MyWriteLine(GenericRef, MessageLine)
end
end;
if Err = NoErr then
WriteClosing(GenericRef);
Err := FSClose(GenericRef);
Err := FSClose(HelpRef)
end; { if SendHelp }
if GoodPassword then
begin
for AlterCount := 1 to AddCount do
DisposHandle(Handle(Adds[AlterCount]));
for AlterCount := 1 to DeleteCount do
DisposHandle(Handle(Deletes[AlterCount]))
end { if GoodPassword }
end;
{ ------------------------------------------------------ }
procedure CheckPoint;
{ Checks NodeID field of message to see if it came from a member of the local }
{ point network. }
var
NetPos, SlashPos: integer;
begin
NetPos := pos(PointNetString, NodeID);
SlashPos := pos('/', NodeID);
if (NetPos = 1) & (SlashPos = length(PointNetString) + 1) then
FromPoint := true
else
FromPoint := false
end;
{ ------------------------------------------------------ }
procedure DoFileForward;
var
FilesToDo: integer;
begin
InterpretRequest; { Just want to make sure we've got a good password }
if GoodPassword & (pos('>', Subject) > 0) then
begin
Subject := BlankStrip(Subject);
Subject := copy(Subject, pos('>', Subject) + 1, 255);
Subject := BlankStrip(Subject);
if pos('/', Subject) = 0 then
Subject := concat(PointNetString, '/', Subject);
SendFileName := concat(GenericPath, 'Sendfiles', Subject, '.bbs');
MakeTextFile(SendFileName);
Err := FSOpen(SendFileName, vRefNum, SendFilesRef);
Err := SetFPos(SendFilesRef, fsFromLEOF, 0);
MakeTextFile(concat(GenericPath, 'Generic Export'));
Err := FSOpen(concat(GenericPath, 'Generic Export'), vRefNum, GenExpRef);
Err := SetFPos(GenExpRef, fsFromLEOF, 0);
MakeTextFile(':Tabby:AreaTrix Workfile');
Err := FSOpen(':Tabby:AreaTrix Workfile', vRefNum, AFWLogRef);
Err := SetFPos(AFWLogRef, fsFromLEOF, 0);
if ListForwards then
begin
MakeTextFile(':Tabby:Forward Log');
Err := FSOpen(':Tabby:Forward Log', vRefNum, ForwardLogRef);
Err := SetFPos(ForwardLogRef, fsFromLEOF, 0)
end;
WriteHeading(GenExpRef, ForwardName);
TempString := concat('The following files were processed for forwarding to ', Subject, ':');
Err := MyWriteLine(GenExpRef, TempString);
TempString := ' ';
Err := MyWriteLine(GenExpRef, TempString);
Empty := true;
for FilesToDo := 1 to Index do
begin
TempString := BlankStrip(MsgTextArray[FilesToDo]^^);
if (TempString <> ' ') & (TempString <> TAB) & (TempString <> '') then
begin
TempString := concat(GenericPath, MsgTextArray[FilesToDo]^^);
Err := FSOpen(TempString, vRefNum, FileCheckRef);
if Err = NoErr then
begin
Empty := false;
Err := FSClose(FileCheckRef);
Err := MyWriteLine(SendFilesRef, TempString);
TempLogString := concat(MsgTextArray[FilesToDo]^^, TAB, 'Sendfiles', Subject, '.bbs');
Err := MyWriteLine(AFWLogRef, TempLogString);
TimeStamp;
if ListForwards then
begin
TempLogString := concat(TabbyStamp, ' -- ', MsgTextArray[FilesToDo]^^, ' sent from ', FromName, ' to ', Subject);
Err := MyWriteLine(ForwardLogRef, TempLogString)
end;
TempString := concat(MsgTextArray[FilesToDo]^^, ' -- file set up to be sent');
Err := MyWriteLine(GenExpRef, TempString)
end { if it opened OK }
else if (length(MsgTextArray[FilesToDo]^^) > 1) then
begin
Empty := false;
TempString := concat(MsgTextArray[FilesToDo]^^, ' -- file not found');
Err := MyWriteLine(GenExpRef, TempString)
end
end { if it wasn't an empty line }
end; { for FilesToDo := 1 to Index }
if Empty then
begin
TempString := 'No files found!';
Err := MyWriteLine(GenExpRef, TempString)
end;
Err := FSClose(AFWLogRef);
if ListForwards then
Err := FSClose(ForwardLogRef);
Err := FSClose(SendFilesRef);
WriteClosing(GenExpRef);
Err := FSClose(GenExpRef);
end { if GoodPassword }
end; { if addressed to ForwardName }
{ ------------------------------------------------------ }
procedure DoAreaFix;
begin
InterpretRequest;
if Request = true then
begin
MessageCount := succ(MessageCount);
CheckPoint;
if GoodPassword then
AlterAreas;
SendMsg('AreaFix');
end { If Request = true }
end; { if (CapsToName = 'AREAFIX') | (CapsToName = 'AREATRIX')' }
{ ------------------------------------------------------ }
procedure DoFREQ;
const
LF = chr(10);
var
Counter, FilesToDo, FQRef: integer;
NodeInHex, RequestName, BBSRezName, FileToGet, TempLaunchString: str255;
CharsToRead: longint;
AlreadyThere: boolean;
begin
InterpretRequest; { Just want to make sure we've got a good password }
if GoodPassword & (pos('>', Subject) > 0) then
begin
BBSRezName := GetString(500)^^;
Subject := BlankStrip(Subject);
Subject := copy(Subject, pos('>', Subject) + 1, 255);
Subject := BlankStrip(Subject);
TempString := '';
for Counter := 1 to length(Subject) do
if Subject[Counter] in ['0'..'9', '/'] then
TempString := concat(TempString, Subject[Counter]);
Subject := TempString;
if Subject <> '' then
begin
MakeTextFile('Fakebot Script');
Err := FSOpen('Fakebot Script', vRefNum, FQRef);
if Err = NoErr then
Err := GetEOF(FQRef, logicalEOF);
if (Err = NoErr) & (LogicalEOF > 1) then
begin
Err := SetFPos(FQRef, fsFromLEOF, -1);
CharsToSend := 1;
TempString := SPACE;
if Err = NoErr then
Err := MyWrite(FQRef, TempString);
end;
if Err = NoErr then
Err := SetFPos(FQRef, fsFromLEOF, 0);
CharsToSend := length(Subject);
if Err = NoErr then
Err := MyWriteLine(FQRef, Subject);
Err := FSClose(FQRef); { 'Fakebot Script' }
TempLaunchString := '';
MakeTextFile('launch.next');
Err := FSOpen('launch.next', vRefNum, FQRef);
if Err = NoErr then
Err := GetEOF(FQRef, logicalEOF);
if Err = NoErr then
if (LogicalEOF < 255) then
begin
Err := ReadALine(FQRef, TempLaunchString);
Err := SetFPos(FQRef, fsFromStart, 0)
end
else
begin
CharsToRead := 255;
Err := SetFPos(FQRef, fsFromLEOF, -255);
Err := FSRead(FQRef, CharsToRead, @TempLaunchString);
TempLaunchString := copy(TempLaunchString, 1, length(TempLaunchString) - 1); {trim CR}
Err := SetFPos(FQRef, fsFromLEOF, -255)
end;
if (Err = NoErr) then
if pos(BBSRezName, TempLaunchString) > 0 then
TempLaunchString := copy(TempLaunchString, 1, pos(BBSRezName, TempLaunchString) - 1);
while (TempLaunchString[length(TempLaunchString)] in [',', SPACE]) do
TempLaunchString := copy(TempLaunchString, 1, length(TempLaunchString) - 1);
TempLaunchString := concat(TempLaunchString, ',', FREQName, ENDLINE);
if Err = NoErr then
Err := MyWrite(FQRef, TempLaunchString);
if LogicalEOF < 255 then
Err := SetEOF(FQRef, length(TempLaunchString))
else
Err := SetEOF(FQRef, logicalEOF + length(TempLaunchString) - 255);
Err := FSClose(FQRef); { 'launch.next' }
NodeInHex := HexNode(Subject);
RequestName := concat(':Tabby:', NodeInHex, '.REQ');
MakeTextFile(RequestName);
Err := FSOpen(RequestName, vRefNum, FQRef);
if Err = NoErr then
Err := SetFPos(FQRef, fsFromLEOF, 0);
if Err = NoErr then
for FilesToDo := 1 to Index do
begin
FileToGet := BlankStrip(MsgTextArray[FilesToDo]^^);
if (FileToGet[1] = '-') & (FileToGet[2] = '-') & (FileToGet[3] = '-') then
leave
else if (FileToGet <> ' ') & (FileToGet <> TAB) & (FileToGet <> '') then
begin
Err := MyWriteLine(FQRef, FileToGet);
TempString := LF;
Err := MyWrite(FQRef, TempString); {write linefeed after CR}
end; { if (TempString <> ' ') & (TempString <> TAB) & (TempString <> '') }
end; { for FilesToDo := 1 to Index }
Err := FSClose(FQRef); { ':Tabby:', NodeInHex, '.REQ' }
AlreadyThere := false;
SendFileName := concat(GenericPath, 'Sendfiles', Subject, '.bbs');
MakeTextFile(SendFileName);
Err := FSOpen(SendFileName, vRefNum, FQRef);
while not AtEOF(FQRef) do
begin
Err := ReadALine(FQRef, TempString);
if Tempstring = RequestName then
AlreadyThere := true
end;
if not AlreadyThere then
begin
if Err = NoErr then
Err := SetFPos(FQRef, fsFromLEOF, 0);
if Err = NoErr then
Err := MyWriteLine(FQRef, RequestName);
end; { if not AlreadyThere }
Err := FSClose(FQRef); { 'Sendfiles', Subject, '.bbs' }
end { if Subject <> '' }
end { if GoodPassword & (pos('>', Subject) > 0) }
end; { procedure DoFREQ }
{ ------------------------------------------------------ }
begin
Request := false;
Err := FSOpen(':Tabby:Tabby Config', vRefNum, TConfigRef);
if Err = NoErr then
begin
Err := ReadALine(TConfigRef, LocalNodeID);
Err := FSClose(TConfigRef);
Colon := pos(':', LocalNodeID);
LocalNodeID := copy(LocalNodeID, Colon + 1, length(LocalNodeID) - Colon);
ReadAreas; { Read Areas.bbs file and store info }
ReadPointFeeds; { Read PointGroups file and store info }
Err := FSOpen('AreaTrix.req', vRefNum, AreafixRef);
if Err = NoErr then
Err := GetEOF(AreafixRef, AreaFixEOF);
if (Err = NoErr) and (AreaFixEOF > 0) then
begin
Err := GetFPos(AreafixRef, FlagPos);
while (FlagPos < AreaFixEOF) do
begin
Err := ReadALine(AreafixRef, FlagLine);
if FlagLine[1] <> 'D' then
begin
Err := SetFPos(AreafixRef, fsFromStart, FlagPos);
FlagLine[1] := 'D';
Err := MyWriteLine(AreafixRef, FlagLine);
Err := ReadALine(AreafixRef, Ignore); { Sect }
Err := ReadALine(AreafixRef, Ignore); { Date }
Err := ReadALine(AreafixRef, Ignore); { Time }
Err := ReadALine(AreafixRef, NodeID);
Err := ReadALine(AreafixRef, FromName);
Err := ReadALine(AreafixRef, ToName);
CapsToName := ToName;
UprString(CapsToName, false);
Err := ReadALine(AreafixRef, Subject);
Index := 1;
TextLine := '';
while (not AtEOF(AreafixRef)) & (pos(NULL, TextLine) = 0) & (Index < 401) do
begin
Err := ReadALine(AreafixRef, TextLine);
if (pos(NULL, TextLine) = 0) & (Err = NoErr) then
begin
MsgTextArray[Index] := MsgTextHndl(NewHandle(sizeOf(MsgTextLine)));
HLock(Handle(MsgTextArray[Index]));
MsgTextArray[Index]^^ := TextLine;
Index := succ(Index)
end
end;
Index := pred(Index);
if CapsToName = CapsFwdName then
DoFileForward
else if (CapsToName = 'AREAFIX') | (CapsToName = 'AREATRIX') then
DoAreaFix
else if CapsToName = CapsFREQName then
DoFREQ
else if CapsToName = CapsAgentName then
begin
InterpretRequest; { Just want to make sure we've got a good password }
if GoodPassword then
begin
end
end;
for Counter := 1 to Index do
begin
HUnlock(Handle(MsgTextArray[Counter]));
DisposHandle(Handle(MsgTextArray[Counter]))
end
end { if FlagLine[1] <> 'D' }
else
begin { FlagLine[1] = 'D' }
TextLine := '';
while (pos(chr(0), TextLine) = 0) & (FlagPos < AreaFixEOF) do
begin
Err := ReadALine(AreafixRef, TextLine);
Err := GetFPos(AreafixRef, FlagPos)
end
end; { if FlagLine[1] = 'D' }
Err := GetFPos(AreafixRef, FlagPos)
end { while (FlagPos < AreaFixEOF) }
end; { if (Err = NoErr) and (AreaFixEOF > 0) }
Err := FSClose(AreafixRef);
UpdateAreaFile(':Tabby:areas.bbs', AreaArray, AreaIndex);
UpdateAreaFile(':Tabby:PointGroups', PointFeedArray, PointIndex);
for Counter := 1 to AreaIndex do
begin
HUnlock(Handle(AreaArray[Counter]));
DisposHandle(Handle(AreaArray[Counter]))
end;
for Counter := 1 to PointIndex do
begin
HUnlock(Handle(PointFeedArray[Counter]));
DisposHandle(Handle(PointFeedArray[Counter]))
end
end { if Err = NoErr for Config file }
end;
{ ------------------------------------------------------ }
procedure Initialize;
type
NumVersion = packed record
case INTEGER of
0: (
majorRev: SignedByte; {1st part of version number in BCD }
minorRev: 0..9; {2nd part is 1 nibble in BCD}
bugFixRev: 0..9; {3rd part is 1 nibble in BCD}
stage: SignedByte; {stage code: dev, alpha, beta, final}
nonRelRev: SignedByte
); {revision level of non-released version}
1: (
version: LONGINT
); {to use all 4 fields at one time}
end;
VersRec = record
numericVersion: NumVersion; {encoded version number}
countryCode: INTEGER; {country code from intl utilities}
shortVersion: STR255; {version number string - worst case}
reserved: STR255; {longMessage string packed after shortVersion }
end;
VersRecPtr = ^VersRec;
VersRecHndl = ^VersRecPtr;
var
versionHndl: VersRecHndl;
begin
CurrentResFile := CurResFile;
versionHndl := VersRecHndl(NewHandle(sizeOf(VersRec)));
versionHndl := VersRecHndl(GetResource('vers', 1));
NumToString(versionHndl^^.numericVersion.majorRev, TheVers);
NumToString(versionHndl^^.numericVersion.minorRev, TempString);
TheVers := concat(TheVers, '.', TempString);
if (versionHndl^^.numericVersion.bugFixRev > 0) then
begin
NumToString(versionHndl^^.numericVersion.bugFixRev, TempString);
TheVers := concat(TheVers, TempString)
end;
DisposHandle(Handle(versionHndl));
OptionStr := GetString(501)^^;
uprString(OptionStr, false);
if OptionStr[1] = 'Y' then
MsgToSysop := true
else
MsgToSysop := false;
if OptionStr[2] = 'Y' then
ListOK := true
else
ListOK := false;
if OptionStr[3] = 'Y' then
TabbyLog := true
else
TabbyLog := false;
if OptionStr[4] = 'Y' then
ListForwards := true
else
ListForwards := false;
if OptionStr[5] = 'Y' then
DeleteForwards := true
else
DeleteForwards := false;
if OptionStr[6] = 'Y' then
ListFREQs := true
else
ListFREQs := false;
ForwardName := GetString(502)^^;
CapsFwdName := ForwardName;
uprString(CapsFwdName, false);
FREQName := GetString(503)^^;
CapsFREQName := FREQName;
uprString(CapsFREQName, false);
AgentName := GetString(504)^^;
CapsAgentName := AgentName;
uprString(CapsAgentName, false)
end;
{ ------------------------------------------------------ }
procedure WriteLogStart;
begin
TimeStamp;
MakeTextFile(':Tabby:Tabby Log');
Err := FSOpen(':Tabby:Tabby Log', vRefNum, TLogRef);
Err := SetFPos(TLogRef, fsFromLEOF, 0);
TempString := concat(TabbyStamp, 'AreaTrix - Program Starting');
Err := MyWriteLine(TLogRef, TempString);
Err := FSClose(TLogRef)
end;
{ ------------------------------------------------------ }
procedure WriteLogEnd;
begin
TimeStamp;
Err := FSOpen(':Tabby:Tabby Log', vRefNum, TLogRef);
Err := SetFPos(TLogRef, fsFromLEOF, 0);
NumToString(MessageCount, TempString);
TempString := concat('AreaTrix - ', TempString, ' request');
if MessageCount <> 1 then
TempString := concat(TempString, 's');
TempString := concat(TempString, ' processed');
TempString := concat(TabbyStamp, TempString);
Err := MyWriteLine(TLogRef, TempString);
TempString := concat(TabbyStamp, 'AreaTrix - Program Ending');
Err := MyWriteLine(TLogRef, TempString);
Err := FSClose(TLogRef)
end;
{ ------------------------------------------------------ }
function ReadShortFile (FileName: STR255): STR255;
var
fileRef: integer;
endOfFile: longint;
OneLine: STR255;
begin
Err := FSOpen(FileName, vRefNum, fileRef);
if (Err = NoErr) then
Err := GetEOF(fileRef, endOfFile);
if (endOfFile > 0) & (Err = NoErr) then
Err := ReadALine(fileRef, OneLine)
else
OneLine := '';
if (Err = NoErr) then
Err := FSClose(fileRef);
ReadShortFile := OneLine
end;
{ ------------------------------------------------------ }
begin
Initialize;
if Button then
HandleDialog(TheVers) { If user is holding down the mouse button, reconfigure and end }
else
begin
DialogPointer := GetNewDialog(1001, nil, POINTER(-1));
DrawDialog(DialogPointer);
SetPort(DialogPointer);
if TabbyLog then
WriteLogStart;
HelloTabby; { find out what's next on the launchpad }
GenericPath := ReadShortFile(':Generic');
PurgeFiles(GenericPath);
PointNetString := ReadShortFile(':Tabby:Point Net');
MessageCount := 0;
PreScan(GenericPath, CapsFwdName, CapsFREQName, FixPending);
if FixPending then
begin
ParseReq;
Err := FSDelete('AreaTrix.req', vRefNum)
end; { if FixPending }
if TabbyLog then
WriteLogEnd;
DisposDialog(DialogPointer)
end; { not holding down button }
if NextLaunch <> '' then
LaunchNextAppl
end. { of main routine }
